home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / demonstr / lexuniv.ml < prev    next >
Encoding:
Text File  |  1995-06-01  |  2.8 KB  |  80 lines  |  [TEXT/MPS ]
  1. let rec lire_entier accumulateur flux =
  2.   match flux with
  3.     [< '(`0`..`9` as c) >] ->
  4.       lire_entier (10 * accumulateur + int_of_char c - 48) flux
  5.   | [< >] ->
  6.       accumulateur;;
  7.  
  8. let tampon = "----------------";;
  9.  
  10. let rec lire_mot position flux =
  11.   match flux with
  12.     [< '(`A`..`Z` | `a`..`z` | `0`..`9` | `_` | `'` | 
  13.          `é`|`à`|`è`|`ù`|`â`|`ê`|`î`|`ô`|`û`|`ë`|`ï`|`ü`|`ç`|
  14.          `É`|`À`|`È`|`Ù`|`Â`|`Ê`|`Î`|`Ô`|`Û`|`À`|`Ï`|`Ü`|`Ç`
  15.          as c) >] ->
  16.       if position < string_length tampon then
  17.         set_nth_char tampon position c;
  18.       lire_mot (position+1) flux
  19.   | [< >] ->
  20.       sub_string tampon 0 (min position (string_length tampon));;
  21. let rec lire_symbole position flux =
  22.   match flux with
  23.     [< '(`!`|`$`|`%`|`&`|`*`|`+`|`-`|`.`|`/`|`:`|
  24.          `;`|`<`|`=`|`>`|`?`|`@`|`^`|`|`|`~` as c) >] ->
  25.       if position < string_length tampon then
  26.         set_nth_char tampon position c;
  27.       lire_symbole (position + 1) flux
  28.   | [< >] ->
  29.       sub_string tampon 0 (min position (string_length tampon));;
  30. let rec lire_commentaire flux =
  31.   match flux with
  32.     [< '`\n` >] -> ()
  33.   | [< 'c >] -> lire_commentaire flux;;
  34. let mc_ou_ident table_des_mots_clés ident =
  35.     try hashtbl__find table_des_mots_clés ident
  36.     with Not_found -> Ident(ident);;
  37. let mc_ou_erreur table_des_mots_clés caractère =
  38.     let ident = make_string 1 caractère in
  39.     try hashtbl__find table_des_mots_clés ident
  40.     with Not_found -> raise Parse_error;;
  41. let rec lire_lexème table flux =
  42.   match flux with
  43.     [< '(` `|`\n`|`\r`|`\t`) >] ->
  44.       lire_lexème table flux
  45.   | [< '`#` >] ->
  46.       lire_commentaire flux; lire_lexème table flux
  47.   | [< '(`A`..`Z` | `a`..`z` | 
  48.          `é`|`à`|`è`|`ù`|`â`|`ê`|`î`|`ô`|`û`|`ë`|`ï`|`ü`|`ç`|
  49.          `É`|`À`|`È`|`Ù`|`Â`|`Ê`|`Î`|`Ô`|`Û`|`Ë`|`Ï`|`Ü`|`Ç`
  50.          as c) >] ->
  51.       set_nth_char tampon 0 c;
  52.       mc_ou_ident table (lire_mot 1 flux)
  53.   | [< '(`!`|`$`|`%`|`&`|`*`|`+`|`.`|`/`|`:`|`;`|
  54.          `<`|`=`|`>`|`?`|`@`|`^`|`|`|`~` as c) >] ->
  55.       set_nth_char tampon 0 c;
  56.       mc_ou_ident table (lire_symbole 1 flux)
  57.   | [< '(`0`..`9` as c) >] ->
  58.       Entier(lire_entier (int_of_char c - 48) flux)
  59.   | [< '`-` >] ->
  60.       begin match flux with
  61.         [< '(`0`..`9` as c) >] ->
  62.           Entier(- (lire_entier  (int_of_char c - 48) flux))
  63.       | [< >] ->
  64.           set_nth_char tampon 0 `-`;
  65.           mc_ou_ident table (lire_symbole 1 flux)
  66.       end
  67.   | [< 'c >] ->
  68.       mc_ou_erreur table c;;
  69. let rec analyseur table flux =
  70.     stream_from (function () -> 
  71.       match flux with
  72.        [< (lire_lexème table) lexème >] -> lexème
  73.      | [< >] -> raise Parse_failure);;
  74. let construire_analyseur mots_clés =
  75.     let table_des_mots_clés = hashtbl__new 17 in
  76.     do_list
  77.       (function mot -> hashtbl__add table_des_mots_clés mot (MC mot))
  78.       mots_clés;
  79.     analyseur table_des_mots_clés;;
  80.